home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / chart.arc / CHART.BAS next >
BASIC Source File  |  1988-04-30  |  4KB  |  136 lines
  1. 1 REM ************** ANCESTRY CHART PROGRAM **************
  2. 2 REM
  3. 3 REM VERSION OF PEDIGREE CHART PROGRAM BY JOHN E. ERICSON
  4. 4 REM REWRITTEN FOR IBM PRESONAL COMPUTER BY JOHN E SCULLY
  5. 10 CLS:KEY OFF
  6. 24 DIM N$(31)
  7. 25 D$=CHR$(4)
  8. 30 GOSUB 100:REM ERASE
  9. 40 GOTO 1000:REM MENU
  10. 98 REM  ********** ERASE CHART SUBROUTINE  **********
  11. 100 FOR I=1 TO 31
  12. 110 N$(I)=""
  13. 120 NEXT I
  14. 130 RETURN
  15. 198 REM ************ ENTER ROUTINE *********8
  16. 200 CLS:GOSUB 100:REM CLEAR
  17. 205 LOCATE 2,5:PRINT "ENTER NAMES (PRESS R TO RETURN TO MENU)"
  18. 209 I=0
  19. 210 I=I+1:IF I=32 THEN 1000
  20. 220 PRINT "NAME #";I;TAB(11)
  21. 225 INPUT"";A$
  22. 227 IF A$="" THEN 210
  23. 230 IF A$="R" THEN 1000 
  24. 232 IF A$="r" THEN 1000 
  25. 240 N$(I)=A$
  26. 250 GOTO 210
  27. 260 GOTO 990:REM RETURN TO MENU
  28. 270 IF I<>16 THEN 340
  29. 298 REM LOOK
  30. 300 CLS
  31. 305 LOCATE 4,20
  32. 310 FOR I=1 TO 31
  33. 320 IF I<>16 THEN 340
  34. 330 PRINT:INPUT"PRESS ENTER TO CONTINUE";A$:CLS:LOCATE 4,2
  35. 340 A=I:A$=STR$(A)
  36. 350 PRINT TAB(3-LEN(A$));A$;"> ";N$(A)
  37. 370 NEXT I
  38. 380 GOTO 990:REM CONTINUE
  39. 398 REM  ********** READ CHART FROM DISK  *********
  40. 400 CLS:GOSUB 2000:REM FILE NAME
  41. 420 OPEN F$ FOR INPUT AS #1
  42. 440 FOR I=1 TO 31
  43. 450 INPUT#1,N$(I)
  44. 460 NEXT I
  45. 470 CLOSE #1:GOTO 1000
  46. 598 REM ********* SAVE CHART ON DISK ***********
  47. 600 CLS:GOSUB 2000:REM FILE NAME
  48. 610 OPEN F$ FOR APPEND AS #1
  49. 630 FOR I=1 TO 31
  50. 640 WRITE#1,N$(I)
  51. 650 NEXT I
  52. 660 CLOSE #1:GOTO 1000
  53. 665 IF C$="" THEN 1000
  54. 670 GOTO 1000:REM RETURN TO MAIN MENU
  55. 698 REM DELETE
  56. 700 GOSUB 2000:REM FILE NAME
  57. 720 GOTO 990:REM RETURN TO MAIN MENU
  58. 798 REM ******* MODIFY LIST ROUTINE *********
  59. 800 CLS:LOCATE 8,15
  60. 805 INPUT"ENTER NUMBER OF NAME ";A
  61. 810 IF A=0 THEN 890
  62. 820 IF A<1 OR A>31 OR A <> INT (A) THEN PRINT "INVALID ENTRY":GOTO 800
  63. 830 LOCATE 11,15:PRINT "NAME #";A;"> ";N$(A)
  64. 840 LOCATE 13,15:INPUT"IS THIS THE CORRECT NAME, Y OR N ";A$
  65. 850 IF A$="Y" THEN 1000
  66. 855 IF A$="y" THEN 1000 
  67. 856 IF A$="yes" THEN 1000
  68. 857 IF A$="YES" THEN 1000
  69. 860 LOCATE 15,15:INPUT "ENTER CORRECT NAME ";N$(A)
  70. 890 GOTO 1000:REM   RETURN TO MAIN MENU
  71. 990 PRINT:INPUT"PRESS ENTER TO RETURN TO MENU";A$
  72. 998 REM ******* MENU *********
  73. 1000 CLS:LOCATE 2,26:PRINT "ANCESTRY CHART PROGRAM"
  74. 1005 LOCATE 3,26:PRINT STRING$(22,196)
  75. 1010 LOCATE 5,26:PRINT "A. ERASE LIST"
  76. 1020 LOCATE 7,26:PRINT "B. NEW LIST" 
  77. 1030 LOCATE 9,26:PRINT "C. DISPLAY LIST"
  78. 1040 LOCATE 11,26:PRINT "D. RETRIEVE STORED LIST"
  79. 1050 LOCATE 13,26:PRINT "E. STORE LIST"
  80. 1060 LOCATE 15,26:PRINT "F. MODIFY LIST" 
  81. 1070 LOCATE 17,26:PRINT "G. DELETE STORED LIST"
  82. 1080 LOCATE 19,26:PRINT "H. PRINT ANCESTRY CHART"
  83. 1095 LOCATE 24,5:INPUT "PRESS LETTER TO SELECT";B$
  84. 1110 IF B$="A" THEN 30
  85. 1115 IF B$="a" THEN 30
  86. 1120 IF B$="B" THEN 200
  87. 1125 IF B$="b" THEN 200
  88. 1130 IF B$="C" THEN 300 
  89. 1135 IF B$="c" THEN 300
  90. 1140 IF B$="D" THEN 400
  91. 1145 IF B$="d" THEN 400
  92. 1150 IF B$="E" THEN 600
  93. 1155 IF B$="e" THEN 600
  94. 1160 IF B$="F" THEN 800
  95. 1165 IF B$="f" THEN 800
  96. 1170 IF B$="G" THEN 700
  97. 1175 IF B$="g" THEN 700
  98. 1180 IF B$="H" THEN 3000
  99. 1185 IF B$="h" THEN 3000
  100. 1200 PRINT CHR$(7)
  101. 1210 GOTO 1000
  102. 1998 REM    ******** FILE NAME SUBROUTINE  ***********8
  103. 2000 LOCATE 12,29:INPUT"ENTER FILE NAME ";F$
  104. 2020 RETURN
  105. 2998 REM  ********** PRINT SUBROUTINE ***********
  106. 3000 CLS:LOCATE 10,20
  107. 3010 PRINT "BE SURE PRINTER IS ON"
  108. 3015 LOCATE 12,20
  109. 3020 INPUT "PRESS ENTER WHEN READY",A$
  110. 3025 LPRINT CHR$(14);"ANCESTRY CHART"
  111. 3030 CLS:RESTORE:LOCATE 12,19
  112. 3035 PRINT "****** THE CHART IS BEING PRINTED ******"
  113. 3040 FOR I=1 TO 31
  114. 3050 T=1
  115. 3060 READ A
  116. 3070 IF A>1 THEN T=11
  117. 3080 IF A>3 THEN T=25
  118. 3090 IF A>7 THEN T=37
  119. 3100 IF A>15 THEN T=55
  120. 3105 LPRINT CHR$(0)
  121. 3110 LPRINT TAB(T);A;
  122. 3120 IF N$(A)="" THEN LPRINT "?":GOTO 3140
  123. 3130 LPRINT N$(A)
  124. 3140 NEXT I
  125. 3142 LPRINT CHR$(12)
  126. 3145 CLS
  127. 3150 LOCATE 12,20
  128. 3170 GOTO 990:REM RETURN TO MAIN MENU 
  129. 3998 REM  ******* DATA ******
  130. 4000 DATA 16,8,17,4,18
  131. 4010 DATA 9,19,2,20,10
  132. 4020 DATA 21,5,22,11,23
  133. 4030 DATA 1,24,12,25,6
  134. 4040 DATA 26,13,27,3,28
  135. 4050 DATA 14,29,7,30,15,31
  136.